home *** CD-ROM | disk | FTP | other *** search
/ TPUG - Toronto PET Users Group / TPUG Users Group CD / TPUG Users Group CD.iso / COMAL / Z-Misc Series / (k)zd.d64 / fkeys.proc < prev    next >
Text File  |  2007-03-01  |  4KB  |  171 lines
  1. 9000 // DELETE "@:FKEYS.PRC"
  2. 9005 //
  3. 9010 // LIST   "FKEYS.PRC"
  4. 9015 //
  5. 9020 // EXTENDING CBM COMAL-80 VS 0.14
  6. 9025 // WITH 2.0 LIKE PROCEDURES:
  7. 9030 //    SHOWKEYS
  8. 9035 //    DEFKEYS
  9. 9040 //    BELL
  10. 9045 //    ERRTEXT
  11. 9050 //    QUOTE'MODE
  12. 9055 //    LINK'ERRORS
  13. 9056 //    USE'ERRORS
  14. 9060 //                BY DICK KLINGENS
  15. 9065 //         DUTCH COMAL USERS GROUP
  16. 9070 //                           NOV85
  17. 9075 //
  18. 9080 // *******************************
  19. 9085 // * ONLY POSSIBLE AFTER SPECIAL *
  20. 9090 // * ├╧═┴╠ BOOT                  *
  21. 9095 // *******************************
  22. 9100 //
  23. 9105 PROC SHOWKEYS CLOSED
  24. 9110 BASE:=49152+5*256+4*16+4
  25. 9115 FOR N:=0 TO 8 DO // INTERNAL KEY#
  26. 9120 NO:=N
  27. 9125 NOBACK(NO) //    - CONVERSION TO
  28. 9130 PRINT NO; //       FUNCTION KEY#
  29. 9135 T:=0 //         - CODE CHARACTER
  30. 9140 NUL:=FALSE //      - END OF CODE
  31. 9145 WHILE T<10 AND NOT NUL DO
  32. 9150 BYTE:=PEEK(BASE+N*10+T)
  33. 9155 IF BYTE THEN // - NO EMPTY CODE
  34. 9160 IF BYTE<32 THEN
  35. 9165 IF T<>1 THEN PRINT "+",
  36. 9170 PRINT "CHR$(",BYTE,")",
  37. 9175 ELIF BYTE<128 THEN
  38. 9180 PRINT CHR$(BYTE),
  39. 9185 ELIF BYTE<160 THEN
  40. 9190 IF T<>1 THEN PRINT "+",
  41. 9195 PRINT "CHR$(",BYTE,")",
  42. 9200 ELSE 
  43. 9205 PRINT CHR$(BYTE),
  44. 9210 ENDIF 
  45. 9215 ELSE 
  46. 9220 NUL:=TRUE // - END OF CODE NOW
  47. 9225 ENDIF 
  48. 9230 T:+1 //        - NEXT CHARACTER
  49. 9235 ENDWHILE 
  50. 9240 PRINT 
  51. 9245 ENDFOR N
  52. 9250 ENDPROC SHOWKEYS
  53. 9255 //
  54. 9260 PROC NORMAL'KEYS CLOSED
  55. 9265 DIM Q$ OF 1, CR$ OF 1
  56. 9270 Q$:=CHR$(34) //           - QUOTE
  57. 9275 CR$:=CHR$(13) //- CARRIAGE RETURN
  58. 9280 DEFKEY(0,"CHAIN "+Q$+"*"+Q$+CR$)
  59. 9285 DEFKEY(1,"")
  60. 9290 DEFKEY(3,"")
  61. 9295 DEFKEY(5,"")
  62. 9300 DEFKEY(7,"RUN"+CR$)
  63. 9305 DEFKEY(2,"PASS "+Q$+"I"+Q$+CR$)
  64. 9310 DEFKEY(4,"AUTO ")
  65. 9315 DEFKEY(6,"LIST ")
  66. 9320 DEFKEY(8,"RENUM"+CR$)
  67. 9325 ENDPROC NORMAL'KEYS
  68. 9330 //
  69. 9335 PROC DEFKEY(NO,X$) CLOSED
  70. 9340 IF NO<0 OR NO>8 THEN
  71. 9345 ERRTEXT(3)
  72. 9350 ENDIF 
  73. 9355 KEYNO(NO) //      - CONVERSION TO
  74. 9360 //            INTERNAL KEY NUMBER
  75. 9365 BASE:=49152+5*256+4*16+4
  76. 9370 BASE:+(NO*10)
  77. 9375 FOR T:=1 TO LEN(X$) DO
  78. 9380 POKE BASE-1+T,ORD(X$(T))
  79. 9385 ENDFOR T
  80. 9390 IF LEN(X$)<>10 THEN
  81. 9395 POKE BASE+LEN(X$),0
  82. 9400 ENDIF 
  83. 9405 ENDPROC DEFKEY
  84. 9410 //
  85. 9415 PROC KEYNO(REF NO) CLOSED
  86. 9420 //                - CONVERSION TO
  87. 9425 //            INTERNAL KEY NUMBER
  88. 9430 IF NO<>0 THEN
  89. 9435 IF NO MOD 2=0 THEN //     - EVEN
  90. 9440 NO:=INT((NO-1)/2)+5
  91. 9445 ELSE 
  92. 9450 NO:=INT(NO/2)+1
  93. 9455 ENDIF 
  94. 9460 ENDIF 
  95. 9465 ENDPROC KEYNO
  96. 9470 //
  97. 9475 PROC NOBACK(REF NO) CLOSED
  98. 9480 //                - CONVERSION TO
  99. 9485 //            FUNCTION KEY NUMBER
  100. 9490 NO:=NO*2-1-(NO>4)*7+(NO=0)
  101. 9495 ENDPROC NOBACK
  102. 9500 //
  103. 9505 PROC BELL(NUM) CLOSED
  104. 9510 IF NUM<0 OR NUM>255 THEN
  105. 9515 ERRTEXT(3)
  106. 9520 ENDIF 
  107. 9525 FOR T:=1 TO NUM DO
  108. 9530 PRINT CHR$(7),
  109. 9535 ENDFOR T
  110. 9540 ENDPROC BELL
  111. 9545 //
  112. 9550 PROC ERRTEXT(NO) CLOSED
  113. 9555 IF NO<0 OR NO>255 THEN
  114. 9560 ERRTEXT(3)
  115. 9565 ENDIF 
  116. 9570 BELL(1)
  117. 9575 PRINT CHR$(27),CHR$(NO)
  118. 9580 STOP 
  119. 9585 ENDPROC ERRTEXT
  120. 9590 //
  121. 9595 PROC QUOTE'MODE(TF) CLOSED
  122. 9600 //       TF=TRUE   QUOTE'MODE ON
  123. 9605 //       TF=FALSE: QUOTE'MODE OFF
  124. 9610 IF TF*(TF-1)<>0 THEN
  125. 9615 ERRTEXT(3)
  126. 9620 ENDIF 
  127. 9625 IF TF THEN
  128. 9630 CBM'MODE(1,3)
  129. 9635 ELSE 
  130. 9640 CBM'MODE(0,0)
  131. 9645 ENDIF 
  132. 9650 ENDPROC QUOTE'MODE
  133. 9655 //
  134. 9660 PROC CBM'MODE(TF,TYPE) CLOSED
  135. 9665 //      TYPE=1: INSERT'MODE(TRUE)
  136. 9670 //      TYPE=2: QUOTE'MODE(TRUE)
  137. 9675 //      TYPE=3: BOTH(TRUE)
  138. 9680 IF TF=0 THEN
  139. 9685 POKE 50336,0
  140. 9690 ELIF TF=1 THEN
  141. 9695 IF TYPE>0 AND INT(TYPE)=TYPE THEN
  142. 9700 IF 6 MOD TYPE=0 THEN
  143. 9705 POKE 50336,64*TYPE
  144. 9710 ELSE 
  145. 9715 ERRTEXT(3)
  146. 9720 ENDIF 
  147. 9725 ELSE 
  148. 9730 ERRTEXT(3)
  149. 9735 ENDIF 
  150. 9740 ELSE 
  151. 9745 ERRTEXT(3)
  152. 9750 ENDIF 
  153. 9755 ENDPROC CBM'MODE
  154. 9760 //
  155. 9765 PROC LINK'ERRORS CLOSED
  156. 9770 SYS 51550
  157. 9775 POKE 2048,0
  158. 9780 //            ERRORS IN MEMORY: 0
  159. 9785 //            ERRORS FROM DISK: 1
  160. 9790 ENDPROC LINK'ERRORS
  161. 9795 //
  162. 9800 PROC DISCARD'ERRORS CLOSED
  163. 9805 POKE 2048,1
  164. 9810 POKE 4312,0 //            SETMSG-
  165. 9815 ENDPROC DISCARD'ERRORS
  166. 9820 //
  167. 9825 PROC USE'ERRORS CLOSED
  168. 9830 POKE 2048,0
  169. 9835 POKE 4312,1 //            SETMSG+
  170. 9840 ENDPROC USE'ERRORS
  171.